perm filename PICSHT.SAI[PIX,HPM] blob sn#426071 filedate 1979-03-14 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	BEGIN "PICSHE"
C00009 ENDMK
C⊗;
BEGIN "PICSHE"
REQUIRE "VIXHDR.SAI[VIS,HPM]" SOURCE_FILE;
DO
  BEGIN "PICBLK"
  INTEGER I,J,K,L,M,PL,LN;  STRING PFL;
  INTEGER SAFE ARRAY PC[0:10],BUF[0:20];
  INTEGER COUNT,BRCHAR,EOF,CH; BOOLEAN FLAG;

  DEFINE WID=1600, HIG=1200;

  PRINT("Picture file:");  PFL←INCHWL; GETPFD(PFL,PC[0]);

  CH←GETCHAN; PRSFIL(PFL); EOF←TRUE;
  OPEN(CH,DEVPRS,'10,19,0,COUNT,BRCHAR,EOF);
  IF ¬EOF THEN LOOKUP(CH,FILPRS,FLAG);
  IF FLAG ∨ EOF THEN
     BEGIN
     RELEASE(CH);
     PRINT("Picture file ",PFL," not found",'15&'12);
     DONE "PICBLK";
     END;
   ARRYIN(CH,BUF[0],10);
   IF BUF[0]=-1 THEN
     BEGIN "new HE format"
     ARRYIN(CH,BUF[10],9);
     I←'200;
       comment in case file is MIT pseudo stanford format, and has no pointers;
     FOR K←18,17,16,15,10,9,8,7 DO IF BUF[K]≠0 THEN I←BUF[K];
     PC[BYBI]←BUF[1];
     PC[LNBY]←BUF[6]-BUF[5]+1;
     PC[PCLN]←BUF[4]-BUF[3]+1;
     PC[WDBY]←36%PC[BYBI];
     PC[LNWD]←BUF[2];
     PC[LNBYA]←PC[LNWD]*PC[WDBY];
     PC[PCWD]←PC[PCLN]*PC[LNWD];
     PC[PCBY]←PC[PCLN]*PC[LNBY];
     PC[PCBYA]←PC[PCLN]*PC[LNBYA];
     PC[WDBI]←PC[WDBY]*PC[BYBI];
     I←(I LAND '777777);
     FOR J←19 STEP 1 UNTIL I-1 DO WORDIN(CH); comment skip to first scanline;
     END
   ELSE
     BEGIN   comment if old hand eye format;
     PC[BYBI]←BUF[2];
     PC[LNBY]←BUF[8]-BUF[7]+1;
     PC[PCLN]←BUF[6]-BUF[5]+1;
     PC[WDBY]←36%PC[BYBI];
     PC[LNWD]←(PC[LNBY]+PC[WDBY]-1)%PC[WDBY];
     PC[LNBYA]←PC[LNWD]*PC[WDBY];
     PC[PCWD]←PC[PCLN]*PC[LNWD];
     PC[PCBY]←PC[PCLN]*PC[LNBY];
     PC[PCBYA]←PC[PCLN]*PC[LNBYA];
     PC[WDBI]←PC[WDBY]*PC[BYBI];
     IF PC[BYBI]≤0 ∨ PC[BYBI]>36 ∨ PC[LNBY]≤0 ∨ PC[PCLN]≤0 ∨ BUF[0]<0 THEN
       BEGIN
       RELEASE(CH);
       PRINT(" ",PFL," is not a picture file",'15&'12);
       DONE "PICBLK";
       END;
     END;

     BEGIN
     INTEGER LW; LABEL DOTPL,BPTDL,ERRSM,ERRSP,ERRSL,BPTSL; REAL BM;
     PRELOAD_WITH '777, '777, '377, '376, '372, '272, '270,'070, '030, '020, '000, '000;
     OWN INTEGER SAFE ARRAY DOTS[-1:10]; INTEGER SAFE ARRAY DOTP[-1:10];

     INTEGER SAFE ARRAY
        SCNLIN[0:PC[LNWD]-1],BPTS,BPTD[0:WID%3],PIC[0:PIXDIM(HIG,WID+36,1)];
     REAL SAFE ARRAY ERRS[-1:WID%3+1];

     MAKPIX(HIG,WID+36,1,PIC[0]);
     FOR J←-1 STEP 1 UNTIL 10 DO DOTP[J]←POINT(3,DOTS[J],26);
     L←POINT(3,MEMORY[PIC[LINTAB]+1],-1);
     FOR J←0 STEP 1 UNTIL (WID-1)%3 DO
       BEGIN
       K←J*PC[LNBY]*3%WID;
       BPTS[J]←POINT(PC[BYBI],SCNLIN[K%PC[WDBY]],((K MOD PC[WDBY])+1)*PC[BYBI]-1);
       IBP(L); BPTD[J]←L;
       END;
     LW←PIC[LNWD];
     BM←9/PC[BMAX];
     
     I←LOCATION(DOTP[0]); START_CODE MOVE 0,I; HRRM 0,DOTPL; END;
     I←LOCATION(BPTD[0]); START_CODE MOVE 0,I; HRRM 0,BPTDL; END;
     I←LOCATION(BPTS[0]); START_CODE MOVE 0,I; HRRM 0,BPTSL; END;
     I←LOCATION(ERRS[0]); START_CODE MOVE 0,I; HRRM 0,ERRSL;
                          SUBI 0,1; HRRM 0,ERRSM; ADDI 0,2; HRRM 0,ERRSP; END;
     PL←-1;
     FOR I←0 STEP 1 UNTIL (HIG-1)%3 DO
	BEGIN
        DEFINE T=1, ER=3, J=2; LABEL DUN;
        INTEGER LWI,JJ;
	LN←I*PC[PCLN]*3%HIG;  LWI←LW*3*I;
        FOR PL←PL STEP 1 UNTIL LN DO ARRYIN(CH,SCNLIN[0],PC[LNWD]);
        ERRS[0]←0;
        JJ←I LAND 1;
        JJ←((JJ-(WID-1)%3) LSH 18) LOR JJ;
	  START_CODE "XLOOP"
          MOVE J,JJ;
   BPTSL: LDB ER,(J); FLTR ER,ER; FMPR ER,BM; ERRSL: FADR ER,(J);
	  FIXR T,ER; FLTR 4,T; FSBR ER,4; FSC ER,'777777;
	  ERRSM: FADRM ER,(J); ERRSP: MOVEM ER,(J);
	  DOTPL: MOVE 3,(T); BPTDL: MOVE 4,(J);  ADD 4,LWI;
	  ILDB 0,3; DPB 0,4; ADD 4,LW;
	  ILDB 0,3; DPB 0,4; ADD 4,LW; ILDB 0,3; DPB 0,4;
          AOBJP J,DUN; AOBJN J,BPTSL; DUN:
	  END "XLOOP";
	END;
     RELEASE(CH);
     PUTPFL(PIC[0],"DSK:FOO.TMP[TMP,HPM]");
     VIDXGP(PIC[0],100,(1620-WID)%2,HIG+200);
     VIDXGP(PIC[0],100,(1620-WID)%2,HIG+200);
     END;
   END "PICBLK" UNTIL TRUE;
END "PICSHE";